home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DIRS.SWG / 0037_Copying and Deleteing DIRS.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  9KB  |  289 lines
  1.  
  2. { Here are programs for Copying and Deleting directories. }
  3.  
  4. }
  5.  
  6. {****************************************************************************}
  7.  
  8. {                               Copy Directory                               }
  9.  
  10. {****************************************************************************}
  11. {$S+}
  12.  
  13. {for large directories alocate some mem true $M compiler directive}
  14. PROGRAM CopyDirectory;
  15. USES DOS,CRT;
  16. VAR DI: SearchRec;
  17.     N1,WWW: string;
  18.  
  19. Procedure Coppy(Source, Target : String);
  20.  
  21. Var InFile, OutFile : File;
  22.     Buffer          : Array[ 1..8192 ] Of Char;
  23.     NumberRead,
  24.     NumberWritten   : Word;
  25.     Attr: Word;
  26.     Time: LongInt;
  27.  
  28. begin
  29.  
  30.    Assign( InFile, Source );
  31.    Reset ( InFile, 1 );     {This is Reset For unTyped Files}
  32.    Assign  ( OutFile, Target );
  33.    ReWrite ( OutFile, 1 );  {This is ReWrite For unTyped Files}
  34.    Repeat
  35.       BlockRead ( InFile, Buffer, Sizeof( Buffer ), NumberRead );
  36.       BlockWrite( OutFile, Buffer, NumberRead, NumberWritten );
  37.    Until (NumberRead = 0) or (NumberRead <> NumberWritten);
  38.    Close( InFile );
  39.    Close( OutFile );
  40.    Assign( InFile, Source);
  41.    GetFAttr(InFile, Attr);
  42.    GetFTime(InFile, Time);
  43.    Assign( OutFile, Target);
  44.    SetFAttr( OutFile, Attr);
  45.    SetFTime( OutFile, Time);
  46.  
  47. end;
  48.  
  49. FUNCTION FileExist(FileName: String) : Boolean;
  50. VAR DirInfo: SearchRec;
  51. BEGIN
  52.      FindFirst(FileName, AnyFile, DirInfo);
  53.      IF (DosError=0) THEN FileExist:=True
  54.                      ELSE FileExist:=False;
  55. END;
  56.  
  57. PROCEDURE CopyDir(Name1,Name2 : String);
  58. VAR GR,GD: SearchRec;
  59.     k,j: Integer;
  60. BEGIN
  61.      k:=0;
  62.      MkDir(Name2);
  63.      Name2:=FExpand(Name2);
  64.      ChDir(Name1);
  65.      FindFirst('*.*',AnyFile,GR);
  66.      WHILE DosError = 0 DO
  67.      BEGIN
  68.           IF GR.Attr AND Directory <> 0 THEN k:=k+1
  69.           ELSE Coppy(Name1+'\'+GR.Name, Name2+'\'+GR.Name);
  70.           FindNext(GR);
  71.      END;
  72.      IF k>2 THEN
  73.      BEGIN
  74.           FindFirst('*.*', AnyFile, GR);
  75.           WHILE DosError = 0 DO
  76.           BEGIN
  77.                j:=2;
  78.                REPEAT
  79.                      IF (GR.Name <> '.') AND (GR.Name <> '..') THEN
  80.                      IF GR.Attr AND Directory <> 0 THEN
  81.                      CopyDir(Name1+'\'+GR.Name, Name2+'\'+GR.Name);
  82.                      FindNext(GR);
  83.                      j:=j+1;
  84.                UNTIL (j=k+1) OR (DosError <> 0);
  85.           END;
  86.      END;
  87. END;
  88.  
  89.  
  90. BEGIN
  91.      WRITELN('                   CopyDir Version 1.0 by AMATRIX Software');
  92.      Writeln;
  93.      Writeln('     This is a freeware, you  can use it  and  distribute it as  you  wish.');
  94.      Writeln('     CopyDir is part of Data Master Version 1.0 which is not yet releasted.');
  95.      Writeln;
  96.      Writeln('                            Programed by Kresimir Mihalj,  august, 1994.');
  97.      Writeln('                            E-Mail:      piko@cromath.math.hr');
  98.      Writeln;
  99.      GetDir(0,www);
  100.      www:=FExpand(www);
  101.      IF (ParamStr(1)='/h') OR (ParamStr(1)='/H') THEN
  102.      BEGIN
  103.           Writeln('  USAGE:');
  104.           Writeln;
  105.           WRITELN('     You mut enter name of directory you copying and  name  of  nonexist');
  106.           WRITELN('     directory where you copy.');
  107.           Writeln('     Example:      CopyDir source target');
  108.      END
  109.      ELSE
  110.      IF (ParamStr(1)='') OR (ParamStr(2)='') THEN
  111.      BEGIN
  112.           Writeln('  ERROR:');
  113.           Writeln;
  114.           WRITELN('     Enter /h switch for help.');
  115.      END
  116.      ELSE
  117.      IF (ParamStr(1)<>'') AND ((ParamStr(1)<>'/h') OR (ParamStr(1)<>'/H')) AND (ParamStr(2)='') THEN
  118.      BEGIN
  119.           Writeln('  ERROR:');
  120.           Writeln;
  121.           WRITELN('     Enter /h switch for help.');
  122.      END
  123.      ELSE
  124.      BEGIN
  125.           IF FileExist(ParamStr(1)) THEN
  126.           BEGIN
  127.                FindFirst(ParamStr(1), AnyFile, DI);
  128.                IF DI.Attr AND Directory <> 0 THEN
  129.                BEGIN
  130.                     IF FileExist(ParamStr(2)) THEN
  131.                     BEGIN
  132.                          Writeln('  ERROR:');
  133.                          WRITELN;
  134.                          Writeln('     ',ParamStr(2),' already exist.');
  135.                     END
  136.                     ELSE
  137.                     BEGIN
  138.                           N1:=FExpand(ParamStr(1));
  139.                           CopyDir(N1,ParamStr(2));
  140.                     END;
  141.                END
  142.                ELSE
  143.                BEGIN
  144.                     Writeln('  ERROR:');
  145.                     Writeln;
  146.                     Writeln('     ',ParamStr(1),' is not a directory')
  147.                END;
  148.           END
  149.           ELSE
  150.           BEGIN
  151.                Writeln('  ERROR:');
  152.                Writeln;
  153.                Writeln('     ',ParamStr(1),' does not exist.');
  154.           END;
  155.      END;
  156.      ChDir(www);
  157. END.
  158.  
  159.  
  160.  
  161. {****************************************************************************}
  162.  
  163. {                               Delete Directory                             }
  164.  
  165. {****************************************************************************}
  166.  
  167. PROGRAM DeleteDirectory;
  168. {for large directories alocate some mem true $M compiler directive}
  169. USES DOS,CRT;
  170. VAR DI: SearchRec;
  171.  
  172. FUNCTION FileExist(FileName: String) : Boolean;
  173. VAR DirInfo: SearchRec;
  174. BEGIN
  175.      FindFirst(FileName, AnyFile, DirInfo);
  176.      IF (DosError=0) THEN FileExist:=True
  177.                      ELSE FileExist:=False;
  178. END;
  179.  
  180.  
  181. PROCEDURE DelDir(Name: String);
  182. VAR k: Integer;
  183.     DD: SearchRec;
  184.     m,w: File;
  185.     s: String;
  186. BEGIN
  187.      REPEAT
  188.            ChDir(Name);
  189.            k:=0;
  190.            FindFirst('*.*', AnyFile, DD);
  191.            While DosError=0 Do
  192.            BEGIN
  193.                 IF DD.Attr AND ReadOnly <> 0 THEN
  194.                 BEGIN
  195.                      Assign(m, DD.Name);
  196.                      SetFAttr(m, Archive);
  197.                 END;
  198.                 IF DD.Attr AND Hidden <> 0 THEN
  199.                 BEGIN
  200.                      Assign(m, DD.Name);
  201.                      SetFAttr(m, Archive);
  202.                 END;
  203.                 IF DD.Attr AND SysFile <> 0 THEN
  204.                 BEGIN
  205.                      Assign(m, DD.Name);
  206.                      SetFAttr(m, Archive);
  207.                 END;
  208.                 IF DD.Attr <> Directory THEN
  209.                 BEGIN
  210.                      Assign(m, DD.Name);
  211.                      Rename(m, '$$$$$$$$.$$$');
  212.                      REWRITE(m);
  213.                      Close(m);
  214.                      Erase(m);
  215.                      Delay(100);
  216.                 END;
  217.                 FindNext(DD);
  218.            END;
  219.            FindFirst('*.*', AnyFile, DD);
  220.            WHILE DosError = 0 DO
  221.            BEGIN
  222.                 IF (DD.Name <> '.') AND (DD.Name <> '..') THEN
  223.                 BEGIN
  224.                      IF DD.Attr AND Directory <> 0 THEN
  225.                      BEGIN
  226.                           DelDir(DD.Name);
  227.                      END;
  228.                 END;
  229.                 FindNext(DD);
  230.            END;
  231.            FindFirst('*.*', AnyFile, DD);
  232.            WHILE DosError = 0 DO
  233.            BEGIN
  234.                 FindNext(DD);
  235.                 k:=k+1;
  236.            END;
  237.            IF k=2 THEN ChDir('..');
  238.            RmDir(Name);
  239.            GetDir(0, s);
  240.      UNTIL (k=2);
  241. END;
  242.  
  243. BEGIN
  244.      WRITELN('                   DelDir Version 1.0 by AMATRIX Software');
  245.      Writeln;
  246.      Writeln('     This is a freeware, you  can use it  and  distribute it as you  wish.');
  247.      Writeln('     DelDir is part of Data Master Version 1.0 which is not yet releasted.');
  248.      Writeln;
  249.      Writeln('                                WARNING !!!');
  250.      Writeln('     DelDir erase & wipe ALL files in specified directory and all subdirs,');
  251.      WRITELN('     no metter on attribute sets, so you cannot undelete erased files.');
  252.      Writeln;
  253.      Writeln('                            Programed by Kresimir Mihalj,  august, 1994.');
  254.      Writeln('                            E-Mail:      piko@cromath.math.hr');
  255.      Writeln;
  256.      IF ParamStr(1)='' THEN
  257.      BEGIN
  258.           Writeln('  ERROR:');
  259.           Writeln;
  260.           Writeln('     Enter /h switch for help.');
  261.      END
  262.      ELSE
  263.      IF (ParamStr(1)='.') OR (ParamStr(1)='..') THEN
  264.      BEGIN
  265.           Writeln('  ERROR:');
  266.           Writeln;
  267.           Writeln('     Cannot erase courent directory.');
  268.      END
  269.      ELSE
  270.      IF (ParamStr(1)='/h') OR (ParamStr(1)='/H') THEN
  271.      BEGIN
  272.           Writeln('  USAGE: ');
  273.           Writeln('     You must specify directory name which you wonna erase.');
  274.           Writeln('     EXAMPLE:     DelDir batfiles');
  275.      END
  276.      ELSE
  277.      IF FileExist(ParamStr(1)) THEN
  278.      BEGIN
  279.           FindFirst(ParamStr(1), AnyFile, DI);
  280.           IF DI.Attr AND Directory <> 0 THEN DelDir(ParamStr(1)) ELSE
  281.           BEGIN
  282.                 Writeln('  ERROR:');
  283.                 Writeln;
  284.                 Writeln('     ',ParamStr(1),' is not a directory.')
  285.           END;
  286.      END
  287.      ELSE WRITELN('     ',ParamStr(1),' does not exist.');
  288. END.
  289.